home *** CD-ROM | disk | FTP | other *** search
/ Delphi Anthology / aDELPHI.iso / Runimage / Delphi50 / Source / Property Editors / updsqled.pas < prev   
Pascal/Delphi Source File  |  1999-08-11  |  26KB  |  948 lines

  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       UpdateSQL Component Editor                      }
  6. {                                                       }
  7. {       Copyright (c) 1997,1999 Inprise Corporation     }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit UpdSqlEd;
  12.  
  13. interface
  14.  
  15. uses Forms, DB, DBTables, ExtCtrls, StdCtrls, Controls, ComCtrls,
  16.   Classes, SysUtils, Windows, Menus;
  17.  
  18. type
  19.  
  20.   TWaitMethod = procedure of object;
  21.  
  22.   TUpdateSQLEditForm = class(TForm)
  23.     OkButton: TButton;
  24.     CancelButton: TButton;
  25.     HelpButton: TButton;
  26.     GenerateButton: TButton;
  27.     PrimaryKeyButton: TButton;
  28.     DefaultButton: TButton;
  29.     UpdateTableName: TComboBox;
  30.     FieldsPage: TTabSheet;
  31.     SQLPage: TTabSheet;
  32.     PageControl: TPageControl;
  33.     KeyFieldList: TListBox;
  34.     UpdateFieldList: TListBox;
  35.     GroupBox1: TGroupBox;
  36.     Label1: TLabel;
  37.     SQLMemo: TMemo;
  38.     FTempTable: TTable;
  39.     StatementType: TRadioGroup;
  40.     QuoteFields: TCheckBox;
  41.     GetTableFieldsButton: TButton;
  42.     FieldListPopup: TPopupMenu;
  43.     miSelectAll: TMenuItem;
  44.     miClearAll: TMenuItem;
  45.     procedure FormCreate(Sender: TObject);
  46.     procedure HelpButtonClick(Sender: TObject);
  47.     procedure StatementTypeClick(Sender: TObject);
  48.     procedure OkButtonClick(Sender: TObject);
  49.     procedure DefaultButtonClick(Sender: TObject);
  50.     procedure GenerateButtonClick(Sender: TObject);
  51.     procedure PrimaryKeyButtonClick(Sender: TObject);
  52.     procedure PageControlChanging(Sender: TObject;
  53.       var AllowChange: Boolean);
  54.     procedure FormDestroy(Sender: TObject);
  55.     procedure GetTableFieldsButtonClick(Sender: TObject);
  56.     procedure SettingsChanged(Sender: TObject);
  57.     procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
  58.     procedure UpdateTableNameChange(Sender: TObject);
  59.     procedure UpdateTableNameClick(Sender: TObject);
  60.     procedure SelectAllClick(Sender: TObject);
  61.     procedure ClearAllClick(Sender: TObject);
  62.     procedure SQLMemoKeyPress(Sender: TObject; var Key: Char);
  63.   private
  64.     StmtIndex: Integer;
  65.     DataSet: TDBDataSet;
  66.     Database: TDatabase;
  67.     DatabaseOpened: Boolean;
  68.     UpdateSQL: TUpdateSQL;
  69.     FSettingsChanged: Boolean;
  70.     FDatasetDefaults: Boolean;
  71.     SQLText: array[TUpdateKind] of TStrings;
  72.     function GetTableRef(const TabName, QuoteChar: string): string;
  73.     function DatabaseOpen: Boolean;
  74.     function Edit: Boolean;
  75.     procedure GenWhereClause(const TabAlias, QuoteChar: string;
  76.       KeyFields, SQL: TStrings);
  77.     procedure GenDeleteSQL(const TableName, QuoteChar: string;
  78.       KeyFields, SQL: TStrings);
  79.     procedure GenInsertSQL(const TableName, QuoteChar: string;
  80.       UpdateFields, SQL: TStrings);
  81.     procedure GenModifySQL(const TableName, QuoteChar: string;
  82.       KeyFields, UpdateFields, SQL: TStrings);
  83.     procedure GenerateSQL;
  84.     procedure GetDataSetFieldNames;
  85.     procedure GetTableFieldNames;
  86.     procedure InitGenerateOptions;
  87.     procedure InitUpdateTableNames;
  88.     procedure SetButtonStates;
  89.     procedure SelectPrimaryKeyFields;
  90.     procedure SetDefaultSelections;
  91.     procedure ShowWait(WaitMethod: TWaitMethod);
  92.     function TempTable: TTable;
  93.   end;
  94.  
  95. { TSQLParser }
  96.  
  97.   TSQLToken = (stSymbol, stAlias, stNumber, stComma, stEQ, stOther, stLParen,
  98.     stRParen, stEnd);
  99.  
  100.   TSQLParser = class
  101.   private
  102.     FText: string;
  103.     FSourcePtr: PChar;
  104.     FTokenPtr: PChar;
  105.     FTokenString: string;
  106.     FToken: TSQLToken;
  107.     FSymbolQuoted: Boolean;
  108.     function NextToken: TSQLToken;
  109.     function TokenSymbolIs(const S: string): Boolean;
  110.     procedure Reset;
  111.   public
  112.     constructor Create(const Text: string);
  113.     procedure GetSelectTableNames(List: TStrings);
  114.     procedure GetUpdateTableName(var TableName: string);
  115.     procedure GetUpdateFields(List: TStrings);
  116.     procedure GetWhereFields(List: TStrings);
  117.   end;
  118.  
  119. function EditUpdateSQL(AUpdateSQL: TUpdateSQL): Boolean;
  120.  
  121. implementation
  122.  
  123. {$R *.DFM}
  124.  
  125. uses Dialogs, BdeConst, LibHelp, TypInfo, BDE;
  126.  
  127. { Global Interface functions }
  128.  
  129. function EditUpdateSQL(AUpdateSQL: TUpdateSQL): Boolean;
  130. begin
  131.   with TUpdateSQLEditForm.Create(Application) do
  132.   try
  133.     UpdateSQL := AUpdateSQL;
  134.     Result := Edit;
  135.   finally
  136.     Free;
  137.   end;
  138. end;
  139.  
  140. { Utility Routines }
  141.  
  142. procedure GetSelectedItems(ListBox: TListBox; List: TStrings);
  143. var
  144.   I: Integer;
  145. begin
  146.   List.Clear;
  147.   for I := 0 to ListBox.Items.Count - 1 do
  148.     if ListBox.Selected[I] then
  149.       List.Add(ListBox.Items[I]);
  150. end;
  151.  
  152. function SetSelectedItems(ListBox: TListBox; List: TStrings): Integer;
  153. var
  154.   I: Integer;
  155. begin
  156.   Result := 0;
  157.   ListBox.Items.BeginUpdate;
  158.   try
  159.     for I := 0 to ListBox.Items.Count - 1 do
  160.       if List.IndexOf(ListBox.Items[I]) > -1 then
  161.       begin
  162.         ListBox.Selected[I] := True;
  163.         Inc(Result);
  164.       end
  165.       else
  166.         ListBox.Selected[I] := False;
  167.     if ListBox.Items.Count > 0 then
  168.     begin
  169.       ListBox.ItemIndex := 0;
  170.       ListBox.TopIndex := 0;
  171.     end;
  172.   finally
  173.     ListBox.Items.EndUpdate;
  174.   end;
  175. end;
  176.  
  177. procedure SelectAll(ListBox: TListBox);
  178. var
  179.   I: Integer;
  180. begin
  181.   ListBox.Items.BeginUpdate;
  182.   try
  183.     with ListBox do
  184.       for I := 0 to Items.Count - 1 do
  185.         Selected[I] := True;
  186.     if ListBox.Items.Count > 0 then
  187.     begin
  188.       ListBox.ItemIndex := 0;
  189.       ListBox.TopIndex := 0;
  190.     end;
  191.   finally
  192.     ListBox.Items.EndUpdate;
  193.   end;
  194. end;
  195.  
  196. procedure GetDataFieldNames(Dataset: TDataset; ErrorName: string; List: TStrings);
  197. var
  198.   I: Integer;
  199. begin
  200.   with Dataset do
  201.   try
  202.     FieldDefs.Update;
  203.     List.BeginUpdate;
  204.     try
  205.       List.Clear;
  206.       for I := 0 to FieldDefs.Count - 1 do
  207.         List.Add(FieldDefs[I].Name);
  208.     finally
  209.       List.EndUpdate;
  210.     end;
  211.   except
  212.     if ErrorName <> '' then
  213.       MessageDlg(Format(SSQLDataSetOpen, [ErrorName]), mtError, [mbOK], 0);
  214.   end;
  215. end;
  216.  
  217. procedure GetSQLTableNames(const SQL: string; List: TStrings);
  218. begin
  219.   with TSQLParser.Create(SQL) do
  220.   try
  221.     GetSelectTableNames(List);
  222.   finally
  223.     Free;
  224.   end;
  225. end;
  226.  
  227. procedure ParseUpdateSQL(const SQL: string; var TableName: string;
  228.   UpdateFields: TStrings; WhereFields: TStrings);
  229. begin
  230.   with TSQLParser.Create(SQL) do
  231.   try
  232.     GetUpdateTableName(TableName);
  233.     if Assigned(UpdateFields) then
  234.     begin
  235.       Reset;
  236.       GetUpdateFields(UpdateFields);
  237.     end;
  238.     if Assigned(WhereFields) then
  239.     begin
  240.       Reset;
  241.       GetWhereFields(WhereFields);
  242.     end;
  243.   finally
  244.     Free;
  245.   end;
  246. end;
  247.  
  248. { TSQLParser }
  249.  
  250. constructor TSQLParser.Create(const Text: string);
  251. begin
  252.   FText := Text;
  253.   FSourcePtr := PChar(Text);
  254.   NextToken;
  255. end;
  256.  
  257. function TSQLParser.NextToken: TSQLToken;
  258. var
  259.   P, TokenStart: PChar;
  260.   QuoteChar: Char;
  261.   IsParam: Boolean;
  262.  
  263.   function IsKatakana(const Chr: Byte): Boolean;
  264.   begin
  265.     Result := (SysLocale.PriLangID = LANG_JAPANESE) and (Chr in [$A1..$DF]);
  266.   end;
  267.  
  268. begin
  269.   if FToken = stEnd then SysUtils.Abort;
  270.   FTokenString := '';
  271.   FSymbolQuoted := False;
  272.   P := FSourcePtr;
  273.   while (P^ <> #0) and (P^ <= ' ') do Inc(P);
  274.   FTokenPtr := P;
  275.   case P^ of
  276.     'A'..'Z', 'a'..'z', '_', '$', #127..#255:
  277.       begin
  278.         TokenStart := P;
  279.         if not SysLocale.FarEast then
  280.         begin
  281.           Inc(P);
  282.           while P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '"', '$', #127..#255] do Inc(P);
  283.         end
  284.         else
  285.           begin
  286.             while TRUE do
  287.             begin
  288.               if (P^ in ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', '"', '$']) or
  289.                  IsKatakana(Byte(P^)) then
  290.                 Inc(P)
  291.               else
  292.                 if P^ in LeadBytes then
  293.                   Inc(P, 2)
  294.                 else
  295.                   Break;
  296.             end;
  297.           end;
  298.         SetString(FTokenString, TokenStart, P - TokenStart);
  299.         FToken := stSymbol;
  300.       end;
  301.     '''', '"':
  302.       begin
  303.         QuoteChar := P^;
  304.         Inc(P);
  305.         IsParam := P^ = ':';
  306.         if IsParam then Inc(P);
  307.         TokenStart := P;
  308.         while not (P^ in [QuoteChar, #0]) do Inc(P);
  309.         SetString(FTokenString, TokenStart, P - TokenStart);
  310.         Inc(P);
  311.         Trim(FTokenString);
  312.         FToken := stSymbol;
  313.         FSymbolQuoted := True;
  314.       end;
  315.     '-', '0'..'9':
  316.       begin
  317.         TokenStart := P;
  318.         Inc(P);
  319.         while P^ in ['0'..'9', '.', 'e', 'E', '+', '-'] do Inc(P);
  320.         SetString(FTokenString, TokenStart, P - TokenStart);
  321.         FToken := stNumber;
  322.       end;
  323.     ',':
  324.       begin
  325.         Inc(P);
  326.         FToken := stComma;
  327.       end;
  328.     '=':
  329.       begin
  330.         Inc(P);
  331.         FToken := stEQ;
  332.       end;
  333.     '(':
  334.       begin
  335.         Inc(P);
  336.         FToken := stLParen;
  337.       end;
  338.     ')':
  339.       begin
  340.         Inc(P);
  341.         FToken := stRParen;
  342.       end;
  343.     #0:
  344.       FToken := stEnd;
  345.   else
  346.     begin
  347.       FToken := stOther;
  348.       Inc(P);
  349.     end;
  350.   end;
  351.   FSourcePtr := P;
  352.   if (FToken = stSymbol) and
  353.     (FTokenString[Length(FTokenString)] = '.') then FToken := stAlias;
  354.   Result := FToken;
  355. end;
  356.  
  357. procedure TSQLParser.Reset;
  358. begin
  359.   FSourcePtr := PChar(FText);
  360.   FToken := stSymbol;
  361.   NextToken;
  362. end;
  363.  
  364. function TSQLParser.TokenSymbolIs(const S: string): Boolean;
  365. begin
  366.   Result := (FToken = stSymbol) and (CompareText(FTokenString, S) = 0);
  367. end;
  368.  
  369. procedure TSQLParser.GetSelectTableNames(List: TStrings);
  370. begin
  371.   List.BeginUpdate;
  372.   try
  373.     List.Clear;
  374.     if TokenSymbolIs('SELECT') then { Do not localize }
  375.     try
  376.       while not TokenSymbolIs('FROM') do NextToken; { Do not localize }
  377.       NextToken;
  378.       while FToken = stSymbol do
  379.       begin
  380.         List.AddObject(FTokenString, Pointer(Integer(FSymbolQuoted)));
  381.         if NextToken = stSymbol then NextToken;
  382.         if FToken = stComma then NextToken
  383.         else break;
  384.       end;
  385.     except
  386.     end;
  387.   finally
  388.     List.EndUpdate;
  389.   end;
  390. end;
  391.  
  392. procedure TSQLParser.GetUpdateTableName(var TableName: string);
  393. begin
  394.   if TokenSymbolIs('UPDATE') and (NextToken = stSymbol) then { Do not localize }
  395.     TableName := FTokenString else
  396.     TableName := '';
  397. end;
  398.  
  399. procedure TSQLParser.GetUpdateFields(List: TStrings);
  400. begin
  401.   List.BeginUpdate;
  402.   try
  403.     List.Clear;
  404.     if TokenSymbolIs('UPDATE') then { Do not localize }
  405.     try
  406.       while not TokenSymbolIs('SET') do NextToken; { Do not localize }
  407.       NextToken;
  408.       while True do
  409.       begin
  410.         if FToken = stAlias then NextToken;
  411.         if FToken <> stSymbol then Break;
  412.         List.Add(FTokenString);
  413.         if NextToken <> stEQ then Break;
  414.         while NextToken <> stComma do
  415.           if TokenSymbolIs('WHERE') then Exit;{ Do not localize }
  416.         NextToken;
  417.       end;
  418.     except
  419.     end;
  420.   finally
  421.     List.EndUpdate;
  422.   end;
  423. end;
  424.  
  425. procedure TSQLParser.GetWhereFields(List: TStrings);
  426. begin
  427.   List.BeginUpdate;
  428.   try
  429.     List.Clear;
  430.     if TokenSymbolIs('UPDATE') then { Do not localize }
  431.     try
  432.       while not TokenSymbolIs('WHERE') do NextToken; { Do not localize }
  433.       NextToken;
  434.       while True do
  435.       begin
  436.         while FToken in [stLParen, stAlias] do NextToken;
  437.         if FToken <> stSymbol then Break;
  438.         List.Add(FTokenString);
  439.         if NextToken <> stEQ then Break;
  440.         while true do
  441.         begin
  442.           NextToken;
  443.           if FToken = stEnd then Exit;
  444.           if TokenSymbolIs('AND') then Break; { Do not localize }
  445.         end;
  446.         NextToken;
  447.       end;
  448.     except
  449.     end;
  450.   finally
  451.     List.EndUpdate;
  452.   end;
  453. end;
  454.  
  455. { TUpdateSQLEditor }
  456.  
  457. { Private Methods }
  458.  
  459. function TUpdateSQLEditForm.DatabaseOpen: Boolean;
  460. begin
  461.   if Assigned(Database) then
  462.     Result := True
  463.   else
  464.   begin
  465.     Result := False;
  466.     if not Assigned(DataSet) then Exit;
  467.     if Assigned(DataSet.Database) then
  468.     begin
  469.       Database := DataSet.Database;
  470.       Result := True;
  471.     end
  472.     else
  473.     begin
  474.       Database := DataSet.OpenDatabase;
  475.       DatabaseOpened := True;
  476.       Result := True;
  477.     end;
  478.   end;
  479. end;
  480.  
  481. function TUpdateSQLEditForm.Edit: Boolean;
  482. var
  483.   Index: TUpdateKind;
  484.   DataSetName: string;
  485. begin
  486.   Result := False;
  487.   if Assigned(UpdateSQL.DataSet) and (UpdateSQL.DataSet is TDBDataSet) then
  488.   begin
  489.     DataSet := TDBDataSet(UpdateSQL.DataSet);
  490.     FTempTable.SessionName := DataSet.SessionName;
  491.     FTempTable.DatabaseName := DataSet.DatabaseName;
  492.     DataSetName := Format('%s%s%s', [DataSet.Owner.Name, DotSep, DataSet.Name]);
  493.   end else
  494.     DataSetName := SNoDataSet;
  495.   Caption := Format('%s%s%s (%s)', [UpdateSQL.Owner.Name, DotSep, UpdateSQL.Name, DataSetName]);
  496.   try
  497.     for Index := Low(TUpdateKind) to High(TUpdateKind) do
  498.     begin
  499.       SQLText[Index] := TStringList.Create;
  500.       SQLText[Index].Assign(UpdateSQL.SQL[Index]);
  501.     end;
  502.     StatementTypeClick(Self);
  503.     InitUpdateTableNames;
  504.     ShowWait(InitGenerateOptions);
  505.     PageControl.ActivePage := PageControl.Pages[0];
  506.     if ShowModal = mrOk then
  507.     begin
  508.       for Index := low(TUpdateKind) to high(TUpdateKind) do
  509.         UpdateSQL.SQL[Index] := SQLText[Index];
  510.       Result := True;
  511.     end;
  512.   finally
  513.     for Index := Low(TUpdateKind) to High(TUpdateKind) do
  514.       SQLText[Index].Free;
  515.   end;
  516. end;
  517.  
  518. procedure TUpdateSQLEditForm.GenWhereClause(const TabAlias, QuoteChar: string;
  519.   KeyFields, SQL: TStrings);
  520. var
  521.   I: Integer;
  522.   BindText: string;
  523.   FieldName: string;
  524. begin
  525.   SQL.Add('where'); { Do not localize }
  526.   for I := 0 to KeyFields.Count - 1 do
  527.   begin
  528.     FieldName := KeyFields[I];
  529.     BindText := Format('  %s%s%s%1:s = :%1:sOLD_%2:s%1:s', { Do not localize }
  530.       [TabAlias, QuoteChar, FieldName]);
  531.     if I < KeyFields.Count - 1 then
  532.       BindText := Format('%s and',[BindText]); { Do not localize }
  533.     SQL.Add(BindText);
  534.   end;
  535. end;
  536.  
  537. procedure TUpdateSQLEditForm.GenDeleteSQL(const TableName, QuoteChar: string;
  538.   KeyFields, SQL: TStrings);
  539. begin
  540.   SQL.Clear;
  541.   SQL.Add(Format('delete from %s', [TableName])); { Do not localize }
  542.   GenWhereClause(GetTableRef(TableName, QuoteChar), QuoteChar, KeyFields, SQL);
  543. end;
  544.  
  545. procedure TUpdateSQLEditForm.GenInsertSQL(const TableName, QuoteChar: string;
  546.   UpdateFields, SQL: TStrings);
  547.  
  548.   procedure GenFieldList(const TabName, ParamChar, QuoteChar: String);
  549.   var
  550.     L: string;
  551.     I: integer;
  552.     Comma: string;
  553.   begin
  554.     L := '  (';
  555.     Comma := ', ';
  556.     for I := 0 to UpdateFields.Count - 1 do
  557.     begin
  558.       if I = UpdateFields.Count - 1 then Comma := '';
  559.       L := Format('%s%s%s%s%s%3:s%5:s',
  560.         [L, TabName, ParamChar, QuoteChar, UpdateFields[I], Comma]);
  561.       if (Length(L) > 70) and (I <> UpdateFields.Count - 1) then
  562.       begin
  563.         SQL.Add(L);
  564.         L := '   ';
  565.       end;
  566.     end;
  567.     SQL.Add(L+')');
  568.   end;
  569.  
  570. begin
  571.   SQL.Clear;
  572.   SQL.Add(Format('insert into %s', [TableName])); { Do not localize }
  573.   GenFieldList(GetTableRef(TableName, QuoteChar), '', QuoteChar);
  574.   SQL.Add('values'); { Do not localize }
  575.   GenFieldList('', ':', QuoteChar);
  576. end;
  577.  
  578. procedure TUpdateSQLEditForm.GenModifySQL(const TableName, QuoteChar: string;
  579.   KeyFields, UpdateFields, SQL: TStrings);
  580. var
  581.   I: integer;
  582.   Comma: string;
  583.   TableRef: string;
  584. begin
  585.   SQL.Clear;
  586.   SQL.Add(Format('update %s', [TableName]));  { Do not localize }
  587.   SQL.Add('set');                             { Do not localize }
  588.   Comma := ',';
  589.   TableRef := GetTableRef(TableName, QuoteChar);
  590.   for I := 0 to UpdateFields.Count - 1 do
  591.   begin
  592.     if I = UpdateFields.Count -1 then Comma := '';
  593.     SQL.Add(Format('  %s%s%s%1:s = :%1:s%2:s%1:s%3:s',
  594.       [TableRef, QuoteChar, UpdateFields[I], Comma]));
  595.   end;
  596.   GenWhereClause(TableRef, QuoteChar, KeyFields, SQL);
  597. end;
  598.  
  599. procedure TUpdateSQLEditForm.GenerateSQL;
  600.  
  601.   function QuotedTableName(const BaseName: string): string;
  602.   begin
  603.     with UpdateTableName do
  604.       if ((ItemIndex <> -1) and (Items.Objects[ItemIndex] <> nil)) or
  605.          (DatabaseOpen and not Database.IsSQLBased and (Pos('.', BaseName) > 0)) then
  606.          Result := Format('"%s"', [BaseName]) else
  607.          Result := BaseName;
  608.   end;
  609.  
  610. var
  611.   KeyFields: TStringList;
  612.   UpdateFields: TStringList;
  613.   QuoteChar, TableName: string;
  614. begin
  615.   if (KeyFieldList.SelCount = 0) or (UpdateFieldList.SelCount = 0) then
  616.     raise Exception.CreateRes(@SSQLGenSelect);
  617.   KeyFields := TStringList.Create;
  618.   try
  619.     GetSelectedItems(KeyFieldList, KeyFields);
  620.     UpdateFields := TStringList.Create;
  621.     try
  622.       GetSelectedItems(UpdateFieldList, UpdateFields);
  623.       TableName := QuotedTableName(UpdateTableName.Text);
  624.       if QuoteFields.Checked then
  625.         QuoteChar := '"' else
  626.         QuoteChar := '';
  627.       GenDeleteSQL(TableName, QuoteChar, KeyFields, SQLText[ukDelete]);
  628.       GenInsertSQL(TableName, QuoteChar, UpdateFields, SQLText[ukInsert]);
  629.       GenModifySQL(TableName, QuoteChar, KeyFields, UpdateFields,
  630.         SQLText[ukModify]);
  631.       SQLMemo.Modified := False;
  632.       StatementTypeClick(Self);
  633.       PageControl.SelectNextPage(True);
  634.     finally
  635.       UpdateFields.Free;
  636.     end;
  637.   finally
  638.     KeyFields.Free;
  639.   end;
  640. end;
  641.  
  642. procedure TUpdateSQLEditForm.GetDataSetFieldNames;
  643. begin
  644.   if Assigned(DataSet) then
  645.   begin
  646.     GetDataFieldNames(DataSet, DataSet.Name, KeyFieldList.Items);
  647.     UpdateFieldList.Items.Assign(KeyFieldList.Items);
  648.   end;
  649. end;
  650.  
  651. procedure TUpdateSQLEditForm.GetTableFieldNames;
  652. begin
  653.   GetDataFieldNames(TempTable, TempTable.TableName, KeyFieldList.Items);
  654.   UpdateFieldList.Items.Assign(KeyFieldList.Items);
  655.   FDatasetDefaults := False;
  656. end;
  657.  
  658. function TUpdateSQLEditForm.GetTableRef(const TabName, QuoteChar: string): string;
  659. begin
  660.   if QuoteChar <> '' then
  661.     Result :=  TabName + '.' else
  662.     REsult := '';
  663. end;
  664.  
  665. procedure TUpdateSQLEditForm.InitGenerateOptions;
  666. var
  667.   UpdTabName: string;
  668.  
  669.   procedure InitFromDataSet;
  670.   begin
  671.     // If this is a Query with more than 1 table in the "from" clause then
  672.     //  initialize the list of fields from the table rather than the dataset.
  673.     if (UpdateTableName.Items.Count > 1) then
  674.       GetTableFieldNames
  675.     else
  676.     begin
  677.       GetDataSetFieldNames;
  678.       FDatasetDefaults := True;
  679.     end;
  680.     SetDefaultSelections;
  681.   end;
  682.  
  683.   procedure InitFromUpdateSQL;
  684.   var
  685.     UpdFields,
  686.     WhFields: TStrings;
  687.   begin
  688.     UpdFields := TStringList.Create;
  689.     try
  690.       WhFields := TStringList.Create;
  691.       try
  692.         ParseUpdateSQL(SQLText[ukModify].Text, UpdTabName, UpdFields, WhFields);
  693.         GetDataSetFieldNames;
  694.         if SetSelectedItems(UpdateFieldList, UpdFields) < 1 then
  695.           SelectAll(UpdateFieldList);
  696.         if SetSelectedItems(KeyFieldList, WhFields) < 1 then
  697.           SelectAll(KeyFieldList);
  698.       finally
  699.         WhFields.Free;
  700.       end;
  701.     finally
  702.       UpdFields.Free;
  703.     end;
  704.   end;
  705.  
  706. begin
  707.   // If there are existing update SQL statements, try to initialize the
  708.   // dialog with the fields that correspond to them.
  709.   if SQLText[ukModify].Count > 0 then
  710.   begin
  711.     ParseUpdateSQL(SQLText[ukModify].Text, UpdTabName, nil, nil);
  712.     // If the table name from the update statement is not part of the
  713.     // dataset, then initialize from the dataset instead.
  714.     if (UpdateTableName.Items.Count > 0) and
  715.        (UpdateTableName.Items.IndexOf(UpdTabName) > -1) then
  716.     begin
  717.       UpdateTableName.Text := UpdTabName;
  718.       InitFromUpdateSQL;
  719.     end else
  720.     begin
  721.       InitFromDataSet;
  722.       UpdateTableName.Items.Add(UpdTabName);
  723.     end;
  724.   end else
  725.     InitFromDataSet;
  726.   SetButtonStates;
  727. end;
  728.  
  729. procedure TUpdateSQLEditForm.InitUpdateTableNames;
  730. begin
  731.   UpdateTableName.Items.Clear;
  732.   if Assigned(DataSet) then
  733.   begin
  734.     if DataSet is TQuery then
  735.       GetSQLTableNames(TQuery(DataSet).SQL.Text, UpdateTableName.Items)
  736.     else if (DataSet is TTable) and (TTable(DataSet).TableName <> '') then
  737.       UpdateTableName.Items.Add(TTable(DataSet).TableName);
  738.   end;
  739.   if UpdateTableName.Items.Count > 0 then
  740.      UpdateTableName.ItemIndex := 0;
  741. end;
  742.  
  743. procedure TUpdateSQLEditForm.SetButtonStates;
  744. begin
  745.   GetTableFieldsButton.Enabled := UpdateTableName.Text <> '';
  746.   PrimaryKeyButton.Enabled := GetTableFieldsButton.Enabled and
  747.     (KeyFieldList.Items.Count > 0);
  748.   GenerateButton.Enabled := GetTableFieldsButton.Enabled and
  749.     (UpdateFieldList.Items.Count > 0) and (KeyFieldList.Items.Count > 0);
  750.   DefaultButton.Enabled := Assigned(DataSet) and not FDatasetDefaults;
  751. end;
  752.  
  753. procedure TUpdateSQLEditForm.SelectPrimaryKeyFields;
  754. var
  755.   SepPos, I, Index: Integer;
  756.   FName, FieldNames: string;
  757. begin
  758.   if KeyFieldList.Items.Count < 1 then Exit;
  759.   with TempTable do
  760.   begin
  761.     IndexDefs.Update;
  762.     for I := 0 to KeyFieldList.Items.Count - 1  do
  763.       KeyFieldList.Selected[I] := False;
  764.     for I := 0 to IndexDefs.Count - 1  do
  765.       if ixPrimary in IndexDefs[I].Options then
  766.       begin
  767.         FieldNames := IndexDefs[I].Fields + ';';
  768.         while Length(FieldNames) > 0 do
  769.         begin
  770.           SepPos := Pos(';', FieldNames);
  771.           if SepPos < 1 then Break;
  772.           FName := Copy(FieldNames, 1, SepPos - 1);
  773.           System.Delete(FieldNames, 1, SepPos);
  774.           Index := KeyFieldList.Items.IndexOf(FName);
  775.           if Index > -1 then KeyFieldList.Selected[Index] := True;
  776.         end;
  777.         break;
  778.       end;
  779.   end;
  780. end;
  781.  
  782. procedure TUpdateSQLEditForm.SetDefaultSelections;
  783. var
  784.   DSFields: TStringList;
  785. begin
  786.   if FDatasetDefaults or not Assigned(DataSet) then
  787.   begin
  788.     SelectAll(UpdateFieldList);
  789.     SelectAll(KeyFieldList);
  790.   end
  791.   else if (DataSet.FieldDefs.Count > 0) then
  792.   begin
  793.     DSFields := TStringList.Create;
  794.     try
  795.       GetDataFieldNames(DataSet, '', DSFields);
  796.       SetSelectedItems(KeyFieldList, DSFields);
  797.       SetSelectedItems(UpdateFieldList, DSFields);
  798.     finally
  799.       DSFields.Free;
  800.     end;
  801.   end;
  802. end;
  803.  
  804. procedure TUpdateSQLEditForm.ShowWait(WaitMethod: TWaitMethod);
  805. begin
  806.   Screen.Cursor := crHourGlass;
  807.   try
  808.     WaitMethod;
  809.   finally
  810.     Screen.Cursor := crDefault;
  811.   end;
  812. end;
  813.  
  814. function TUpdateSQLEditForm.TempTable: TTable;
  815. begin
  816.   if FTempTable.TableName <> UpdateTableName.Text then
  817.   begin
  818.     FTempTable.Close;
  819.     FTempTable.TableName := UpdateTableName.Text;
  820.   end;
  821.   Result := FTempTable;
  822. end;
  823.  
  824. { Event Handlers }
  825.  
  826. procedure TUpdateSQLEditForm.FormCreate(Sender: TObject);
  827. begin
  828.   HelpContext := hcDUpdateSQL;
  829. end;
  830.  
  831. procedure TUpdateSQLEditForm.HelpButtonClick(Sender: TObject);
  832. begin
  833.   Application.HelpContext(HelpContext);
  834. end;
  835.  
  836. procedure TUpdateSQLEditForm.StatementTypeClick(Sender: TObject);
  837. begin
  838.   if SQLMemo.Modified then
  839.     SQLText[TUpdateKind(StmtIndex)].Assign(SQLMemo.Lines);
  840.   StmtIndex := StatementType.ItemIndex;
  841.   SQLMemo.Lines.Assign(SQLText[TUpdateKind(StmtIndex)]);
  842. end;
  843.  
  844. procedure TUpdateSQLEditForm.OkButtonClick(Sender: TObject);
  845. begin
  846.   if SQLMemo.Modified then
  847.     SQLText[TUpdateKind(StmtIndex)].Assign(SQLMemo.Lines);
  848. end;
  849.  
  850. procedure TUpdateSQLEditForm.DefaultButtonClick(Sender: TObject);
  851. begin
  852.   with UpdateTableName do
  853.     if Items.Count > 0 then ItemIndex := 0;
  854.   ShowWait(GetDataSetFieldNames);
  855.   FDatasetDefaults := True;
  856.   SetDefaultSelections;
  857.   KeyfieldList.SetFocus;
  858.   SetButtonStates;
  859. end;
  860.  
  861. procedure TUpdateSQLEditForm.GenerateButtonClick(Sender: TObject);
  862. begin
  863.   GenerateSQL;
  864.   FSettingsChanged := False;
  865. end;
  866.  
  867. procedure TUpdateSQLEditForm.PrimaryKeyButtonClick(Sender: TObject);
  868. begin
  869.   ShowWait(SelectPrimaryKeyFields);
  870.   SettingsChanged(Sender);
  871. end;
  872.  
  873. procedure TUpdateSQLEditForm.PageControlChanging(Sender: TObject;
  874.   var AllowChange: Boolean);
  875. begin
  876.   if (PageControl.ActivePage = PageControl.Pages[0]) and
  877.     not SQLPage.Enabled then
  878.     AllowChange := False;
  879. end;
  880.  
  881. procedure TUpdateSQLEditForm.FormDestroy(Sender: TObject);
  882. begin
  883.   if DatabaseOpened then
  884.     Database.Session.CloseDatabase(Database);
  885. end;
  886.  
  887. procedure TUpdateSQLEditForm.GetTableFieldsButtonClick(Sender: TObject);
  888. begin
  889.   ShowWait(GetTableFieldNames);
  890.   SetDefaultSelections;
  891.   SettingsChanged(Sender);
  892. end;
  893.  
  894. procedure TUpdateSQLEditForm.SettingsChanged(Sender: TObject);
  895. begin
  896.   FSettingsChanged := True;
  897.   FDatasetDefaults := False;
  898.   SetButtonStates;
  899. end;
  900.  
  901. procedure TUpdateSQLEditForm.FormCloseQuery(Sender: TObject;
  902.   var CanClose: Boolean);
  903. begin
  904.   if (ModalResult = mrOK) and FSettingsChanged then
  905.     CanClose := MessageDlg(SSQLNotGenerated, mtConfirmation,
  906.       mbYesNoCancel, 0) = mrYes;
  907. end;
  908.  
  909. procedure TUpdateSQLEditForm.UpdateTableNameChange(Sender: TObject);
  910. begin
  911.   SettingsChanged(Sender);
  912. end;
  913.  
  914. procedure TUpdateSQLEditForm.UpdateTableNameClick(Sender: TObject);
  915. begin
  916.   if not Visible then Exit;
  917.   GetTableFieldsButtonClick(Sender);
  918. end;
  919.  
  920. procedure TUpdateSQLEditForm.SelectAllClick(Sender: TObject);
  921. begin
  922.   SelectAll(FieldListPopup.PopupComponent as TListBox);
  923. end;
  924.  
  925. procedure TUpdateSQLEditForm.ClearAllClick(Sender: TObject);
  926. var
  927.   I: Integer;
  928. begin
  929.   with FieldListPopup.PopupComponent as TListBox do
  930.   begin
  931.     Items.BeginUpdate;
  932.     try
  933.       for I := 0 to Items.Count - 1 do
  934.         Selected[I] := False;
  935.     finally
  936.       Items.EndUpdate;
  937.     end;
  938.   end;
  939. end;
  940.  
  941. procedure TUpdateSQLEditForm.SQLMemoKeyPress(Sender: TObject;
  942.   var Key: Char);
  943. begin
  944.   if Key = #27 then Close;
  945. end;
  946.  
  947. end.
  948.